home *** CD-ROM | disk | FTP | other *** search
/ CD Fun House 1 / CD Fun House (Wayzata Technology).iso / •Word Games• / WordFind ••• / Source / stringstuff < prev    next >
Text File  |  1987-11-14  |  3KB  |  143 lines
  1. UNIT stringf;
  2. INTERFACE
  3.     VAR
  4.         upalpha : STRING;
  5.         lowalpha : STRING;
  6.     PROCEDURE sstrip (VAR word : STRING);
  7.     PROCEDURE wreverse (VAR word : STRING);
  8.     PROCEDURE upper (VAR word : STRING);
  9.     PROCEDURE makealpha (VAR word : STRING);
  10.     FUNCTION alphsize : integer;
  11.     FUNCTION strcmp (s, t : STRING) : integer;
  12.  
  13. IMPLEMENTATION
  14.     FUNCTION alphsize;
  15.     BEGIN
  16.         alphsize := length(upalpha);
  17.     END;
  18.     FUNCTION inpos (c : char) : integer;
  19.         VAR
  20.             i : integer;
  21.     BEGIN
  22.         i := 0;
  23.         REPEAT
  24.             i := i + 1;
  25.         UNTIL (c = lowalpha[i]) OR (i = alphsize);
  26.         IF c = lowalpha[i] THEN
  27.             inpos := i
  28.         ELSE
  29.             inpos := 0;
  30.     END;
  31.  
  32.     PROCEDURE sstrip;
  33.         VAR
  34.             i : integer;
  35.             s : STRING;
  36.     BEGIN
  37.         i := 1;
  38.         s := word;
  39.         WHILE i <= length(s) DO
  40.             IF s[i] = ' ' THEN
  41.                 delete(s, i, 1)
  42.             ELSE
  43.                 i := i + 1;
  44.         word := s;
  45.     END;
  46. (* returns the place in the alphabet of upalpha*)
  47.     FUNCTION index (c : char) : integer;
  48.         VAR
  49.             i : integer;
  50.             st : STRING;
  51.     BEGIN
  52.         st := upalpha;
  53.         i := 0;
  54.         IF length(st) > 0 THEN
  55.             REPEAT
  56.                 i := i + 1;
  57.             UNTIL (c = st[i]) OR (i = length(st));
  58.         IF c = st[i] THEN
  59.             index := i
  60.         ELSE
  61.             index := 0;
  62.     END;
  63.  
  64. (* based on the c function with the same name*)
  65. (*This function returns 1 if s is > t, - 1 if s < t*)
  66. (* and 0 if s and t are identical. Comparison is done*)
  67. (* using upalpha*)
  68.     FUNCTION strcmp;
  69.         VAR
  70.             i, j : integer;
  71.             u, v : STRING;
  72.     BEGIN
  73.         u := s;
  74.         v := t;
  75.         i := 1;
  76.         WHILE (index(u[i]) = index(v[i])) AND (i < length(u)) AND (i < length(v)) DO
  77.             i := i + 1;
  78.         IF i = length(s) THEN
  79.             strcmp := 0
  80.         ELSE IF index(u[i]) > index(v[i]) THEN
  81.             strcmp := 1
  82.         ELSE IF index(u[i]) < index(v[i]) THEN
  83.             strcmp := -1
  84.         ELSE
  85.             strcmp := 0;
  86.     END;
  87.  
  88.  
  89.     PROCEDURE wreverse;
  90.         VAR
  91.             i, l : integer;
  92.             s : STRING;
  93.     BEGIN
  94.         s := word;
  95.         l := length(word);
  96.         FOR i := 1 TO l DO
  97.             word[i] := s[l - i + 1];
  98.     END;
  99.     PROCEDURE upper;
  100.         VAR
  101.             i, lowtest : integer;
  102.             s : STRING;
  103.     BEGIN
  104.         s := word;
  105.         FOR i := 1 TO length(s) DO
  106.             BEGIN
  107.                 lowtest := inpos(s[i]);
  108.                 IF lowtest <> 0 THEN
  109.                     s[i] := upalpha[lowtest];
  110.             END;
  111.         word := s;
  112.     END;
  113.     FUNCTION inup (c : char) : boolean;
  114.         VAR
  115.             i : integer;
  116.             s : STRING;
  117.     BEGIN
  118.         i := 0;
  119.         REPEAT
  120.             i := i + 1;
  121.         UNTIL (i = alphsize) OR (upalpha[i] = c);
  122.         IF upalpha[i] = c THEN
  123.             inup := true
  124.         ELSE
  125.             inup := false;
  126.     END;
  127.     PROCEDURE makealpha;
  128.         VAR
  129.             i : integer;
  130.             s : STRING;
  131.             lowers, uppers : SET OF char;
  132.     BEGIN
  133.         i := 1;
  134.         s := word;
  135.         upper(s);
  136.         WHILE i <= length(s) DO
  137.             IF NOT inup(s[i]) THEN
  138.                 delete(s, i, 1) {zap that character}
  139.             ELSE
  140.                 i := i + 1;
  141.         word := s;
  142.     END;
  143. END.